'option Explicit
if args="" then args=6.063
Dim usr_dx:usr_dx=cdbl(trim(args))

Dim app
set app = application
Dim doc
Set doc = app.ActiveDocument
GetUserLicence(doc)
doc.currentunit=2

AlignCmps_H

Sub AlignCmps_H()

	Dim cmps, cmp
	set cmps = doc.components(1)
	If cmps.count < 2 Then Exit Sub
	


	Dim Y_center, X_start, NewX, X_min
	Dim body_x, body_y
	Dim AYarray, i, j
	Dim tmpx, tmpy, tmpname, tmpbodyx, tmpbodyy
	i = 0

	Dim pos, po, aglignOrientation, oside
	Dim dx

	ReDim AYarray(5, cmps.count)
	For Each cmp In cmps
		AYarray(0, i) = cmp.positionX
		AYarray(1, i) = cmp.positionY
		AYarray(2, i) = cmp.name
		set pos = cmp.PlacementOutlines
		For Each po In pos
			if po.Geometry.IsRect = true then
				AYarray(3, i) = po.Geometry.RectMaxX - po.Geometry.RectMinX
				AYarray(4, i) = po.Geometry.RectMaxY - po.Geometry.RectMinY
			end if
			if po.Geometry.IsCircle = true then
				if left(cmp.name,2)="TP" then
					AYarray(3, i) = 0
					AYarray(4, i) = 0
				else
					AYarray(3, i) = 2* abs(po.Geometry.CircleR)
					AYarray(4, i) = 2* abs(po.Geometry.CircleR)
				end if	
			end if
		Next
		i = i + 1
	Next

	For i = 0 To cmps.count - 2
		For j = i + 1 To cmps.count - 1
			If AYarray(0, i) > AYarray(0, j) Then
				tmpx = AYarray(0, i)
				tmpy = AYarray(1, i)
				tmpname = AYarray(2, i)
				tmpbodyx = AYarray(3, i)
				tmpbodyy = AYarray(4, i)

				AYarray(0, i) = AYarray(0, j)
				AYarray(1, i) = AYarray(1, j)
				AYarray(2, i) = AYarray(2, j)
				AYarray(3, i) = AYarray(3, j)
				AYarray(4, i) = AYarray(4, j)

				AYarray(0, j) = tmpx
				AYarray(1, j) = tmpy
				AYarray(2, j) = tmpname
				AYarray(3, j) = tmpbodyx
				AYarray(4, j) = tmpbodyy

			End If
		Next
	Next
	X_min = AYarray(0, 0)
	Y_center = AYarray(1, 0)
	X_start = AYarray(0, 0) + 0.5 * AYarray(3, 0) + usr_dx
	'X_start = AYarray(0, 0) + AYarray(3, 0) + usr_dx
	
	doc.unselectall()
	Dim compObj
	For i = 1 To cmps.count - 1
		If AYarray(2, i) <> "" Then
			set compObj = doc.findcomponent(AYarray(2, i))
			If Not compObj Is Nothing Then
				set pos = compObj.PlacementOutlines
				aglignOrientation = compObj.Orientation
				If compObj.side = 1 Then
					oside = True
				Else
					oside = False
				End If

				For Each po In pos
					if po.Geometry.IsRect = true then dx = 0.5 * (po.Geometry.RectMaxX - po.Geometry.RectMinX)
					if po.Geometry.IsCircle = true then
						if left(compObj.name,2)="TP" then
							dx =0
						else
							dx =abs(po.Geometry.CircleR)
						end if
					end if
				Next
				NewX = X_start + dx

				If compObj.positionX = NewX And compObj.positionY = Y_center Then
				Else
					'call compObj.Place(NewX, Y_center, aglignOrientation, oside)
					call compObj.move(NewX, Y_center, 0)
				End If

				X_start = NewX + dx + usr_dx
			End If
		End If
	Next
	doc.unselectall()
	set cmps = Nothing
End Sub


' Function to validate document
Private Function ValidateServer(docObj)
    Dim key, licenseServer, licenseToken
    key = docObj.Validate(0)
    Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")
    licenseToken = licenseServer.GetToken(key)
    Set licenseServer = nothing
    'On Error Resume Next
    Err.Clear
    docObj.Validate(licenseToken)
    If Err Then
        ValidateServer = 0    
    Else 
        ValidateServer = 1
    End If
End Function

sub GetUserLicence(docObj)

	If ValidateServer(docObj) = 0 Then
	    msgbox "Server validation failed."
	    exit sub
	End If
	
end sub






''' copy and paste
Function SetClipboardText_fm20(oText)   '剪切读取板信息
    Dim Form, TextBox
	Set Form = CreateObject("Forms.Form.1") 
	Set TextBox = Form.Controls.Add("Forms.TextBox.1").Object 
	TextBox.MultiLine = True 
	TextBox.Text = oText
	TextBox.SelStart = 0 
	TextBox.SelLength = TextBox.TextLength 
	TextBox.Copy
End Function

Function GetClipboardText_fm20()   '剪切读取板信息
    Dim Form, TextBox
	Set Form = CreateObject("Forms.Form.1")
	Set TextBox = Form.Controls.Add("Forms.TextBox.1").Object
	TextBox.MultiLine = True
	If TextBox.CanPaste Then
		 TextBox.Paste
		 args = TextBox.Text
	End If	
	GetClipboardText_fm20 = args
End Function

Sub SetClipboardText(oText)   '写入信息到剪切板
DIM wsShell
    Set wsShell = CreateObject("WScript.Shell")
    wsShell.Run "mshta vbscript:ClipboardData.SetData("&chr(34)&"text"&chr(34)&"," &Chr(34)& oText &Chr(34)& ")(close)",0,True
End Sub

Function GetClipboardText()   '剪切读取板信息
    Set objHTML=CreateObject("htmlfile") 'xmlfile、mhtmlfile也可以
    GetClipboardText = objHTML.ParentWindow.ClipboardData.GetData("text")
End Function